home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / numbrs.lisp < prev    next >
Encoding:
Text File  |  1993-07-17  |  13.8 KB  |  522 lines
  1. ;;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base:10.; Fonts:CPTFONT -*-
  2.  
  3. ;;; (C) Copyright 1985 Massachusetts Institute of Technology
  4. ;;;
  5. ;;; Permission to use, copy, modify, distribute, and sell this software
  6. ;;; and its documentation for any purpose is hereby granted without fee,
  7. ;;; provided that the above copyright notice appear in all copies and that
  8. ;;; both that copyright notice and this permission notice appear in
  9. ;;; supporting documentation, and that the name of M.I.T. not be used in
  10. ;;; advertising or publicity pertaining to distribution of the software
  11. ;;; without specific, written prior permission.  M.I.T. makes no
  12. ;;; representations about the suitability of this software for any
  13. ;;; purpose.  It is provided "as is" without express or implied warranty.
  14. ;;;
  15.  
  16. ;;;constants
  17.  
  18. #-ti(defconst PI 3.14592653)            ;already defined by TI
  19.  
  20. (defconst  pi)
  21.  
  22. (defconst TO-DEGREES (// 180 pi))
  23.  
  24. (defboxer-function bu: () )
  25.  
  26. (defboxer-function bu:pi () PI)
  27.  
  28. ;;; What the evaluator understands as logical values
  29.  
  30. (EVAL-WHEN (LOAD)
  31.   (SHADOW '(TRUE FALSE) 'BOXER)
  32. )
  33.  
  34. (DEFCONST TRUE 'BU:TRUE)
  35.  
  36. (DEFCONST FALSE 'BU:FALSE)
  37.  
  38. (DEFUN TRUE () TRUE)
  39. (DEFUN FALSE () FALSE)
  40.  
  41. ;;; useful to have around for comparing things
  42.  
  43. (DEFCONST TRUE-EVBOX (MAKE-EVDATA ROWS `(,(MAKE-EVROW-FROM-ENTRY 'BU:TRUE))))
  44.  
  45. (DEFCONST FALSE-EVBOX (MAKE-EVDATA ROWS `(,(MAKE-EVROW-FROM-ENTRY 'BU:FALSE))))
  46.  
  47. ;;; Variables for modifying data box arithmetic behavior
  48.  
  49. (DEFVAR *NON-MATCHING-BOX-ARITHMETIC-ACTION* ':ERROR
  50.   "Specifies how to handle situations when the args to arithmetic operations have
  51. differing numbers of elements.  Currently allowed values are :ERROR (signal an error), 
  52. :FILL (fill smaller boxes with zeros), and :TRUNCATE (ignore extra elements in the larger
  53. boxes). ")
  54.  
  55. ;;; is it live, or is it a number
  56. (DEFBOXER-FUNCTION BU:NUMBER? (THING)
  57.   (BOXER-BOOLEAN (BOXER-NUMBER? THING)))
  58.  
  59. (DEFUN BOXER-NUMBER? (THING)
  60.   (OR (NUMBERP THING)
  61.       (NUMBER-BOX? THING)))
  62.  
  63. ;;; Generic operation macros
  64.  
  65. (DEFUN TYPIFY-ARGS (&REST ARGS)
  66.   "Returns :NUMBER if all the args are numbers or :BOX if ANY arg is a box or NIL"
  67.   (IF (NULL (SUBSET #'(LAMBDA (X) (OR (EVAL-BOX? X) (EVAL-PORT? X))) ARGS))
  68.       ':NUMBER
  69.       ':BOX))
  70.  
  71. (DEFMACRO ARG-DISPATCH (OP . ARGS)
  72.   `(SELECTQ (TYPIFY-ARGS ,@ARGS)
  73.      ((:BOX)
  74.       ;; at least one arg is a box so use the box arithmetic routines
  75.       (FUNCALL ',(INTERN (STRING-APPEND "DATA-BOX-" (STRING `,OP))) ,@ARGS))
  76.      ((:NUMBER)
  77.       ;; assume that all the args are numbers (may want to put an error check here)
  78.       (FUNCALL ',OP ,@ARGS))
  79.      (OTHERWISE
  80.       (FERROR "The args, ~A, to ~A were not boxes or numbers" (LIST ,@ARGS) ',OP))))
  81.  
  82. (DEFMETHOD (BOX :ELEMENTS) ()
  83.   (LOOP FOR ROW IN (TELL SELF :ROWS)
  84.     APPENDING (TELL ROW :ELEMENTS)))
  85.  
  86. ;;; Boxer versions of some operators (the others we import directly)
  87.  
  88. (DEFUN BOXER-> (A B)
  89.   (BOXER-BOOLEAN
  90.     (COND ((> A B) t)
  91.       (T NIL))))
  92.  
  93. (DEFUN BOXER-< (A B)
  94.   (BOXER-BOOLEAN
  95.     (COND ((< A B) t)
  96.       (T NIL))))
  97.  
  98. (DEFUN BOXER- (A B)
  99.   (BOXER-BOOLEAN
  100.     (COND (( A B) t)
  101.       (T NIL))))
  102.  
  103. (DEFUN BOXER- (A B)
  104.   (BOXER-BOOLEAN
  105.     (COND (( A B) t)
  106.       (T NIL))))
  107.  
  108. (DEFUN BOXER->= (A B)
  109.   (BOXER-BOOLEAN
  110.     (COND ((>= A B) t)
  111.       (T NIL))))
  112.  
  113. (DEFUN BOXER-<= (A B)
  114.   (BOXER-BOOLEAN
  115.     (COND ((<= A B) t)
  116.       (T NIL))))
  117.  
  118. (DEFUN BOXER-QUOTIENT (divisor dividend)
  119.   (//$ (float divisor) (float dividend)))
  120.  
  121. (DEFUN BOXER-EXPT (A B)
  122.   (if (and (minusp a)
  123.        (floatp b)
  124.        (zerop (- b (fix b))))
  125.       (expt a (fix b))
  126.       (expt a b)))
  127.  
  128. ;  (IF (AND (TYPEP A ':FIX) (TYPEP B ':FIX))
  129. ;      (^ A B)
  130. ;      (^$ (FLOAT A) (FLOAT B))))
  131.  
  132. (DEFUN BOXER-ATAN (Y X)
  133.   (* (ATAN Y X) TO-DEGREES))
  134.  
  135. (DEFUN BOXER-ZERO? (N)
  136.   (BOXER-BOOLEAN (ZEROP N)))
  137.  
  138. (DEFUN BOXER-PLUS? (N)
  139.   (BOXER-BOOLEAN (PLUSP N)))
  140.  
  141. (DEFUN BOXER-MINUS? (N)
  142.   (BOXER-BOOLEAN (MINUSP N)))
  143.  
  144. (DEFUN BOXER-ODD? (N)
  145.   (BOXER-BOOLEAN (when (fixp n) (ODDP N))))
  146.  
  147. (DEFUN BOXER-EVEN? (N)
  148.   (BOXER-BOOLEAN (when (fixp n)(EVENP N))))
  149.  
  150. ;;; Data box arithmetic
  151.  
  152. (DEFUN COMPARE-BOX-LENGTHS (&REST BOXES)
  153.   (LOOP WITH SAME-LENGTH = T
  154.     WITH CURRENT-LENGTH = (GET-BOX-LENGTH-IN-ROWS (CAR BOXES))
  155.     FOR BOX IN BOXES
  156.     FOR LENGTH = (GET-BOX-LENGTH-IN-ROWS BOX)
  157.     UNLESS (= LENGTH CURRENT-LENGTH)
  158.       DO (SETQ SAME-LENGTH NIL)
  159.     MINIMIZE LENGTH INTO SMALLEST-LENGTH
  160.     MAXIMIZE LENGTH INTO LARGEST-LENGTH
  161.     DO (SETQ CURRENT-LENGTH LENGTH)
  162.     FINALLY (RETURN (VALUES SAME-LENGTH SMALLEST-LENGTH LARGEST-LENGTH))))
  163.  
  164. (DEFUN COMPARE-ROW-LENGTHS (&REST ROWS)
  165.   (LOOP WITH CURRENT-LENGTH = (LENGTH (CAR ROWS))
  166.     FOR ROW IN (CDR ROWS)
  167.     FOR LENGTH = (LENGTH ROW)
  168.     WHEN ( LENGTH CURRENT-LENGTH)
  169.       RETURN NIL
  170.     FINALLY (RETURN T)))
  171.  
  172. (DEFUN COLLECT-NTHS (N LISTS)
  173.   (LOOP FOR LIST IN LISTS
  174.     COLLECTING (NTH N LIST)))
  175.  
  176. (DEFUN MAP-OVER-ROW-ELEMENTS (FCN ROWS)
  177.   (MAKE-EVROW-FROM-ENTRIES
  178.     (SELECTQ *NON-MATCHING-BOX-ARITHMETIC-ACTION*
  179.       ((:TRUNCATE) (LEXPR-FUNCALL #'MAPCAR FCN ROWS))
  180.       ((:FILL)
  181.        (LOOP FOR INDEX FROM 0 TO (1- (LEXPR-FUNCALL #'MAX (MAPCAR #'LENGTH ROWS)))
  182.          COLLECTING (APPLY FCN (MAPCAR #'(LAMBDA (X) (OR (NTH INDEX X) 0)) ROWS))))
  183.       (OTHERWISE (IF (LEXPR-FUNCALL #'COMPARE-ROW-LENGTHS ROWS)
  184.              (LEXPR-FUNCALL #'MAPCAR FCN ROWS)
  185.              (FERROR "The rows, ~A have different numbers of elements" ROWS))))))
  186.  
  187. (DEFUN MAP-OVER-BOXS-ELEMENTS (FCN BOXES)
  188.   "Mapping function for functions with mutiple box arguments"
  189.   (LET ((ROWS (MULTIPLE-VALUE-BIND (SAME-SIZE MIN-SIZE MAX-SIZE)
  190.           (LEXPR-FUNCALL #'COMPARE-BOX-LENGTHS BOXES)
  191.         (SELECTQ *NON-MATCHING-BOX-ARITHMETIC-ACTION*
  192.           ((:TRUNCATE)
  193.            (LOOP WITH ROWS-LISTS = (MAPCAR #'GET-BOX-ROWS BOXES)
  194.              FOR INDEX FROM 0 TO (1- MIN-SIZE)
  195.              FOR ROWS = (COLLECT-NTHS INDEX ROWS-LISTS)
  196.              COLLECTING (MAP-OVER-ROW-ELEMENTS FCN ROWS)))
  197.           ((:FILL)
  198.            (LOOP WITH ROWS-LISTS = (MAPCAR #'GET-BOX-ROWS BOXES)
  199.              FOR INDEX FROM 0 TO (1- MAX-SIZE)
  200.              FOR ROWS = (COLLECT-NTHS INDEX ROWS-LISTS)
  201.              COLLECTING (MAP-OVER-ROW-ELEMENTS FCN ROWS)))
  202.           (OTHERWISE
  203.            (IF (NULL SAME-SIZE)
  204.                (FERROR "The boxes ,~A have different numbers of rows" BOXES)
  205.                (LOOP WITH ROWS-LISTS = (MAPCAR #'GET-BOX-ROWS BOXES)
  206.                  FOR INDEX FROM 0 TO (1- MIN-SIZE)
  207.                  FOR ROWS = (COLLECT-NTHS INDEX ROWS-LISTS)
  208.                  COLLECTING (MAP-OVER-ROW-ELEMENTS FCN ROWS))))))))
  209.     (IF (AND (= 1 (LENGTH ROWS)) (= 1 (EVROW-LENGTH-IN-ELEMENTS (CAR ROWS)))
  210.          (NUMBERP (GET-FIRST-ELEMENT-IN-EVROW (CAR ROWS))))
  211.     ;;we flatten boxes with single numbers in them into the numbers
  212.     (GET-FIRST-ELEMENT-IN-EVROW (CAR ROWS))
  213.     (MAKE-EVDATA ROWS ROWS))))
  214.  
  215. (DEFUN MAP-OVER-BOX-ELEMENTS (FCN BOX)
  216.   "Mapping-function for functions which take only a single box argument. "
  217.   (LET ((ROWS (LOOP FOR ROW IN (GET-BOX-ROWS BOX)
  218.             COLLECTING (MAKE-EVROW-FROM-ENTRIES (MAPCAR FCN ROW)))))
  219.     (IF (AND (= 1 (LENGTH ROWS)) (= 1 (EVROW-LENGTH-IN-ELEMENTS (CAR ROWS)))
  220.          (NUMBERP (GET-FIRST-ELEMENT-IN-EVROW (CAR ROWS))))
  221.     ;;we flatten boxes with single numbers in them into the numbers
  222.     (GET-FIRST-ELEMENT-IN-EVROW (CAR ROWS))
  223.     (MAKE-EVDATA ROWS ROWS))))
  224.  
  225. ;;; Multiple data box argument functions
  226.  
  227. (DEFUN DATA-BOX-PLUS (&REST BOXES)
  228.   (MAP-OVER-BOXS-ELEMENTS #'PLUS BOXES))
  229.  
  230. (DEFUN DATA-BOX-DIFFERENCE (&REST BOXES)
  231.   (MAP-OVER-BOXS-ELEMENTS #'DIFFERENCE BOXES))
  232.  
  233. (DEFUN DATA-BOX-TIMES (&REST BOXES)
  234.   (MAP-OVER-BOXS-ELEMENTS #'TIMES BOXES))
  235.  
  236. (DEFUN DATA-BOX-BOXER-QUOTIENT (&REST BOXES)
  237.   (MAP-OVER-BOXS-ELEMENTS #'BOXER-QUOTIENT BOXES))
  238.  
  239. (DEFUN DATA-BOX-REMAINDER (&REST BOXES)
  240.   (MAP-OVER-BOXS-ELEMENTS #'REMAINDER BOXES))
  241.  
  242. (DEFUN DATA-BOX-BOXER-EXPT (&REST BOXES)
  243.   (MAP-OVER-BOXS-ELEMENTS #'BOXER-EXPT BOXES))
  244.  
  245. (DEFUN DATA-BOX-BOXER-ATAN (&REST BOXES)
  246.   (MAP-OVER-BOXS-ELEMENTS #'BOXER-ATAN BOXES))
  247.  
  248. (DEFUN DATA-BOX-GCD (&REST BOXES)
  249.   (MAP-OVER-BOXS-ELEMENTS #'GCD BOXES))
  250.  
  251. (DEFUN DATA-BOX-MAX (&REST BOXES)
  252.   (MAP-OVER-BOXS-ELEMENTS #'MAX BOXES))
  253.  
  254. (DEFUN DATA-BOX-MIN (&REST BOXES)
  255.   (MAP-OVER-BOXS-ELEMENTS #'MIN BOXES))
  256.  
  257. (DEFUN DATA-BOX-BOXER-> (&REST BOXES)
  258.   (MAP-OVER-BOXS-ELEMENTS #'BOXER-> BOXES))
  259.  
  260. (DEFUN DATA-BOX-BOXER-< (&REST BOXES)
  261.   (MAP-OVER-BOXS-ELEMENTS #'BOXER-< BOXES))
  262.  
  263. (DEFUN DATA-BOX-BOXER- (&REST BOXES)
  264.   (MAP-OVER-BOXS-ELEMENTS #'BOXER- BOXES))
  265.  
  266. (DEFUN DATA-BOX-BOXER- (&REST BOXES)
  267.   (MAP-OVER-BOXS-ELEMENTS #'BOXER- BOXES))
  268.  
  269. (DEFUN DATA-BOX-BOXER->= (&REST BOXES)
  270.   (MAP-OVER-BOXS-ELEMENTS #'BOXER->= BOXES))
  271.  
  272. (DEFUN DATA-BOX-BOXER-<= (&REST BOXES)
  273.   (MAP-OVER-BOXS-ELEMENTS #'BOXER-<= BOXES))
  274.  
  275. ;;; Functions which take a single data box argument
  276. ;;; single argument predicates
  277.  
  278. (DEFUN DATA-BOX-BOXER-MINUS? (BOX)
  279.   (MAP-OVER-BOX-ELEMENTS #'BOXER-MINUS? BOX))
  280.  
  281. (DEFUN DATA-BOX-BOXER-PLUS? (BOX)
  282.   (MAP-OVER-BOX-ELEMENTS #'BOXER-PLUS? BOX))
  283.  
  284. (DEFUN DATA-BOX-BOXER-ZERO? (BOX)
  285.   (MAP-OVER-BOX-ELEMENTS #'BOXER-ZERO? BOX))
  286.  
  287. (DEFUN DATA-BOX-BOXER-EVEN? (BOX)
  288.   (MAP-OVER-BOX-ELEMENTS #'BOXER-EVEN? BOX))
  289.  
  290. (DEFUN DATA-BOX-BOXER-ODD? (BOX)
  291.   (MAP-OVER-BOX-ELEMENTS #'BOXER-ODD? BOX))
  292.  
  293. ;;; single argument other stuff
  294. (DEFUN DATA-BOX-SIND (BOX)
  295.   (MAP-OVER-BOX-ELEMENTS #'SIND BOX))
  296.  
  297. (DEFUN DATA-BOX-COSD (BOX)
  298.   (MAP-OVER-BOX-ELEMENTS #'COSD BOX))
  299.  
  300. (DEFUN DATA-BOX-RANDOM (BOX)
  301.   (MAP-OVER-BOX-ELEMENTS #'RANDOM BOX))
  302.  
  303. (DEFUN DATA-BOX-ABS (BOX)
  304.   (MAP-OVER-BOX-ELEMENTS #'ABS BOX))
  305.  
  306. (DEFUN DATA-BOX-SQRT (BOX)
  307.   (MAP-OVER-BOX-ELEMENTS #'SQRT BOX))
  308.  
  309. (DEFUN DATA-BOX-EXP (BOX)
  310.   (MAP-OVER-BOX-ELEMENTS #'EXP BOX))
  311.  
  312. (DEFUN DATA-BOX-LOG (BOX)
  313.   (MAP-OVER-BOX-ELEMENTS #'LOG BOX))
  314.  
  315. (DEFUN DATA-BOX-ROUND (BOX)
  316.   (MAP-OVER-BOX-ELEMENTS #'ROUND BOX))
  317.  
  318. (DEFUN DATA-BOX-FLOOR (BOX)
  319.   (MAP-OVER-BOX-ELEMENTS #'FLOOR BOX))
  320.  
  321. (DEFUN DATA-BOX-CEILING (BOX)
  322.   (MAP-OVER-BOX-ELEMENTS #'CEILING BOX))
  323.  
  324. ;;; LOGICAL and support functions
  325.  
  326. (DEFBOXER-FUNCTION BU:FALSE ()
  327.   FALSE)
  328.  
  329. (DEFBOXER-FUNCTION BU:TRUE ()
  330.   TRUE)
  331.  
  332. (defun boxer-boolean (t-or-nil)
  333.   (if t-or-nil TRUE FALSE))
  334.  
  335. ;;; these are for internal use and return the values T or NIL (NOT TRUE or FALSE)
  336. (defun TRUE? (true-or-false)
  337.   (when (eval-port? true-or-false) (setq true-or-false (get-port-target true-or-false)))
  338.   (COND ((EVAL-BOX? TRUE-OR-FALSE)
  339.      (BOX-EQUAL? TRUE-OR-FALSE TRUE-EVBOX))
  340.     (T (STRING-EQUAL TRUE-OR-FALSE TRUE))))
  341.  
  342. (defun FALSE? (true-or-false)
  343.   (when (eval-port? true-or-false) (setq true-or-false (get-port-target true-or-false)))
  344.   (COND ((EVAL-BOX? TRUE-OR-FALSE)
  345.      (box-equal? true-or-false FALSE-EVBOX))
  346.     (T (STRING-EQUAL TRUE-OR-FALSE FALSE))))
  347.  
  348. ;;; The Boxer functions
  349.                       
  350. (DEFBOXER-FUNCTION BU:NOT (TRUE-OR-FALSE)
  351.   (IF (TRUE? TRUE-OR-FALSE) FALSE TRUE))
  352.  
  353. (DEFUN BOXER-= (A B)
  354.   (COND ((AND (NUMBER-BOX? A) (NUMBER-BOX? B))
  355.      (= (NUMBERIZE A) (NUMBERIZE B)))
  356.     ((OR (STRINGP A) (STRINGP B))  (EQUAL A B))
  357.     ((OR (SYMBOLP A) (SYMBOLP B)) (EQUAL A B))
  358.     ((AND (or (EVAL-BOX? A) (eval-port? a)) (or (EVAL-BOX? B) (eval-port? b)))
  359.       (BOX-EQUAL? A B))
  360.     (T NIL)))
  361.  
  362. (DEFBOXER-FUNCTION BU:= (A B)
  363.   (BOXER-BOOLEAN (BOXER-= A B)))
  364.  
  365. (DEFBOXER-FUNCTION BU: (A B)
  366.   (BOXER-BOOLEAN (NOT (BOXER-= A B))))
  367.  
  368. (DEFBOXER-FUNCTION BU:AND (A B)
  369.   (BOXER-BOOLEAN (AND (TRUE? A)
  370.               (TRUE? B))))
  371.  
  372. (DEFBOXER-FUNCTION BU:OR (A B)
  373.   (BOXER-BOOLEAN (OR (TRUE? A)
  374.              (TRUE? B))))
  375.  
  376. ;;; And into Boxer we go....
  377. ;;; single argument predicates
  378.  
  379. (DEFBOXER-FUNCTION BU:PLUS? (X)
  380.   (arg-dispatch BOXER-PLUS? X))
  381.  
  382. (DEFBOXER-FUNCTION BU:MINUS? (X)
  383.   (arg-dispatch BOXER-MINUS? X))
  384.  
  385. (DEFBOXER-FUNCTION BU:ZERO? (X)
  386.   (ARG-DISPATCH BOXER-ZERO? X))
  387.  
  388. (DEFBOXER-FUNCTION BU:EVEN? (X)
  389.   (arg-dispatch BOXER-EVEN? X))
  390.  
  391. (DEFBOXER-FUNCTION BU:ODD? (X)
  392.   (arg-dispatch BOXER-ODD? X))
  393.  
  394. ;;; single argument other stuff
  395.  
  396. (DEFBOXER-FUNCTION BU:CEILING (FLOAT)
  397.   (ARG-DISPATCH CEILING FLOAT))
  398.  
  399. (defboxer-function bu:round (float)
  400.   (arg-dispatch round float))
  401.  
  402. (defboxer-function bu:floor (float)
  403.   (arg-dispatch floor float))
  404.  
  405. (DEFBOXER-FUNCTION BU:MINUS (BOX)
  406.   (arg-dispatch BOXER-MINUS BOX))
  407.  
  408. (DEFBOXER-FUNCTION BU:RANDOM (LESS-THAN)
  409.   (arg-dispatch RANDOM LESS-THAN))
  410.  
  411. (DEFBOXER-FUNCTION BU:ABS (X)
  412.   (arg-dispatch ABS X))
  413.  
  414. (DEFBOXER-FUNCTION BU:SQRT (X)
  415.   (arg-dispatch SQRT X))
  416.  
  417. (DEFBOXER-FUNCTION BU:EXP (X)
  418.   (arg-dispatch EXP X))
  419.  
  420. (DEFBOXER-FUNCTION BU:LOG (X)
  421.   (arg-dispatch LOG X))
  422.  
  423. (DEFBOXER-FUNCTION BU:SIN (ANGLE)
  424.   (arg-dispatch SIND ANGLE))
  425.  
  426. (DEFBOXER-FUNCTION BU:COS (ANGLE)
  427.   (arg-dispatch COSD ANGLE))
  428.  
  429. ;;; Two argument predicates
  430.  
  431. (DEFBOXER-FUNCTION BU:< (A B)
  432.   (arg-dispatch BOXER-< A B))
  433.  
  434. (DEFBOXER-FUNCTION BU:> (A B)
  435.   (arg-dispatch BOXER-> A B))
  436.  
  437. (DEFBOXER-FUNCTION BU: (A B)
  438.   (arg-dispatch BOXER- A B))
  439.  
  440. (DEFBOXER-FUNCTION BU: (A B)
  441.   (arg-dispatch BOXER- A B))
  442.  
  443. (DEFBOXER-FUNCTION BU:<= (A B)
  444.   (arg-dispatch BOXER-<= A B))
  445.  
  446. (DEFBOXER-FUNCTION BU:>= (A B)
  447.   (arg-dispatch BOXER->= A B))
  448.  
  449. ;;; Two argument other stuff
  450.  
  451. (DEFBOXER-FUNCTION BU:PLUS (A B)
  452.   (arg-dispatch PLUS A B))
  453.  
  454. (DEFBOXER-FUNCTION BU:+ (A B)
  455.   (arg-dispatch PLUS A B))
  456.  
  457. (DEFBOXER-FUNCTION BU:DIFFERENCE (A B)
  458.   (arg-dispatch DIFFERENCE A B))
  459.  
  460. (DEFBOXER-FUNCTION BU:- (A B)
  461.   (arg-dispatch DIFFERENCE A B))
  462.  
  463. (DEFBOXER-FUNCTION BU:TIMES (A B)
  464.   (arg-dispatch TIMES A B))
  465.  
  466. (DEFBOXER-FUNCTION BU:* (A B)
  467.   (arg-dispatch TIMES A B))
  468.  
  469. (DEFBOXER-FUNCTION BU:QUOTIENT (A B)
  470.   (arg-dispatch BOXER-QUOTIENT A B))
  471.  
  472. (DEFBOXER-FUNCTION BU:// (A B)
  473.   (arg-dispatch BOXER-QUOTIENT A B))
  474.  
  475. (DEFBOXER-FUNCTION BU:REMAINDER (A B)
  476.   (arg-dispatch REMAINDER A B))
  477.  
  478. (DEFBOXER-FUNCTION BU:EXPT (A B)
  479.   (arg-dispatch BOXER-EXPT A B))
  480.  
  481. (DEFBOXER-FUNCTION BU:ATAN (A B)
  482.   (arg-dispatch BOXER-ATAN A B))
  483.  
  484. (DEFBOXER-FUNCTION BU:^ (A B)
  485.   (arg-dispatch BOXER-EXPT A B))
  486.  
  487. (DEFBOXER-FUNCTION BU:GCD (A B)
  488.   (arg-dispatch GCD A B))
  489.  
  490. (DEFBOXER-FUNCTION BU:MIN (A B)
  491.   (arg-dispatch MIN A B))
  492.  
  493. (DEFBOXER-FUNCTION BU:MAX (A B)
  494.   (ARG-DISPATCH MAX A B))
  495.  
  496. ;;; rational stuff 
  497. (defun data-box-rational (a)            
  498.   (map-over-box-elements #'rational a))
  499.  
  500. (defun data-box-float (a)
  501.   (map-over-box-elements #'float a))
  502.  
  503. (defun data-box-numerator (a)
  504.   (map-over-box-elements #'numerator a))
  505.  
  506. (defun data-box-denominator (a)            
  507.   (map-over-box-elements #'denominator a))
  508.  
  509. (defboxer-function bu:rational (a)
  510.   (arg-dispatch rational a))
  511.  
  512. (defboxer-function bu:float (a)
  513.   (arg-dispatch float a))
  514.  
  515. (defboxer-function bu:numerator (a)
  516.   (arg-dispatch numerator a))
  517.  
  518. (defboxer-function bu:denominator (a)
  519.   (arg-dispatch denominator a))
  520.  
  521. (load "es://usr//emstsun//guest//load-box.lisp")
  522.